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— Hodirifiatlon History 

4/15/92 (leel44l Modified as required by moduUrization. . . 

EXTERIOR JHTBRPACES 

TIMELIMfiR SEED TYPES 

with tl_s«^; use tl^seed? 

TIMELINER MASTER COmCH AREA 

with ti^ccoBon; use tl_oosiffQn; 

— ' tIMELIHER CGKPILATION-TIME CGHMOH AREA 
with tl_com{»_fiosu uso tl^comp 00m; 

SUBROUTIHE TO ISSUE ieiXTIALI2ATI0N-TIME ERROR MES£A$BS 

With cl^cusser; use tl^ousser; 

TIMELIKER GBNERAL-PDRFOSE SnBROOTXHRS 
with tl_aubs; us« tl.subs; 

riMELIlIER CCMPIIATIQN-TIME SCBROOTIMBS 

With tl_ftonp_«ubs; use tI_e6a^_sob5; 

nSBR-SOP?LIED ISFORMXTION 

With tl_u»cr_lnfo; use tl_ii*cr_in£o; 

USER-SUPPLIED SUBROUTINES 

with tl_user_ean^_fiub«; use tIjuaer_comp_ftub9; 

TEiCT mPUT/OOTPOT PACKAGE 

with t«xt_io; use text^lo; 

TIMELINER IMPDT/OOTPOT PACKAGE 

with tl^io; use ta_io; 



PACKAGE BODY 

p^ck^gc body TL^PARSER 14 

SUBROOTIHE TO OBtAIN A NEW STATEWCNT 

procedure obtaltt_«t»teaent (level 

Stat Use 

Atat"l«tig 

stat_type 

next^type 

$tat^nuB 

eosp_loc 



input . 



in natural; 

out stAt_5tring_cy!>e; 

out coluaa^type; 

out comp_type^type; 

out eoinp_typc2type; 

out stat_pointcr_type; 

out comp,jx>lnter_type> ; 



— STATEMEKT PARSING PROCEDURE 



procedure PARSE^STATEMENT (retum^code ; in out retuifn_cod©_type) is 



OUTPUTS OF OBTAIH^STATEMENT (CANNOT BE STATIC) 

TYPE OF ACCUMULATED INPUT STATEB4ENT 

stat^type : Coiw_typej:ype range Atart_of_input . .direct _at a teaent; 

— TYPE OF NEXT ACCUMOIAtfiD INPUT STATEMENT 

next^type : cojnp^typo^type raage atart_or_input . -direct_6tatetteAt; 

STATEMENT NUMBER 

Atat^nua I atat j>olBter_typc; 

RESERVED LOCATION ZN COMPONENT DATA ARRAY 

oomp_loc : coap^^ifiter^Cypc/ 



SAVED BLOCK INFORMATION 



SAVED BLOCK NAME 

t)lock_j!iame_3«vc : naroe^type (l, ,Bax_nAme_length ■> 

SAVED BLOCK TYPE 

block_type_aave : corop_type_type i-^ un)cnown_ilne; 

SAVED BLOCK LINE NUMBER 

blocle_numjiave : block,^lnter^type 0; 

SAVED BLOCK LOCATION IN CCMPONENT DATA 

bloek_loe_3ave : C0B^_pointer_type :- 0; 

...... SAVED CONSTRUCT INTORMATION 



SAVED CONSTRUCT TYPE 

conBt_type_aAve : eomp_type_cype unknown_lin©; r<L 
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SAVED COVSTftUCT LIKE HDMBEft 

■ SAVED CONSTRaCT LOCATIOH IK COMPONEMT DATA 

const_lac:_5av9 : oomp^peintfirjtypc r= 0; 

XX)CAT10N WHERE "BEPORE* Oft <n«ITHIK* STATEMEHT MDM&eR SKOOIi) 60. 

eonftt_mod_loG : cospjp6inter_type 0; 

— LOCATION WHERE •OTHERWISE* STATEMEHT HUMBBR SHOULD GO... 
consc^orh^loe ; ccKsp_pointerjcype 0; 

LOCAtlOH WHERE -EKD** STATEKEtlT W0H5ER SHOULD GO.,. 

const jend_loc : comp_pointer_typ» :» 0; 

SAVS SZATEUEWT miMBBR •ELSE* STATOCEB7T 

eonat_«l«c_num : scat_poiKter_typc :» 0; 



POft CAIiING CCMPQHEUT PARSER 

RBSmTlNG COMPOHEMT TYPE 

etf ct_l«ft, ct^rlflht : £:Qinp_typo_type; 

— >- RRSDLTIHG CCKPOSIEIIT LOCAXIOfl 

ep, gp_lefCf ep_rlghc s comp,^^inter_type; 

RESULTIHG CCKPONENT SIZE 



MISCELLAKEOOS 

COLOMHS WHERE MATERIAL STARTS AHD ENDS 

cO, cl : oolwnn^type O; 
copO, cfipl : coTumn^type 0; 
parO, para : oolunn^type 0; 

COMPOKENT PQIIITER 

loc 3 cocBp^jtalat£r_typQ; 

DUHMY WMERIC 

nuB : 2ca la redouble; 

Omoa BOOLBAK 

ox : boolean; 

BLOCK NUMBER USED WHEW LOOKING FOR SEQS/SDB£EO$ 

nb : blQck^^iater^cype; 

begin 

INITIALIZE OOONTERS IF FIRST ENTRY,., 

it At«t_n«at_level - 0 then 
njaamcs 0; 
a_blocic« := 0; 
n^stata 0; 
n^compa l; 
n^cuss :- 0; 
n^s* ops 0; 
njpoQl^int^var o; 
n_nuai_Tnt_var o; 
n_cfc4r int war 0? 
n_nuae?ic Tits 0; 
D ehar»Ct«r^lits s- o; 
trap_&^jn_namQS 0; 
trap_Da»_$tateaont^leBgth 0; 
trapjnaxjbiock^ncst level Q; 
trapjBax_stat_ncst^Tevel o; 
trap max^con^.ncst^level :- o; 
max_Bool_buff_usage :- 0; 

max_nua_buff_usage 0; 
max char bu2f_u«a9e :** 0; 

«n<l lf;~ 

... INCREMENT NESTING LEVEL 

atat_ne«c_lovel 3taL_ne»t_l«v»l + 1; 

TRAP KMCIMDH STATEMEHT NESTING DEPTH 

if stat_noat_lewcl > trapjBax_atat_tte»t_l«v«l then 

trap max Atat_ncst_level stat ncst_level; 
end if; " " 

— • COMPLAIN IF NESTING TOO DEEP 

1£ stat_Ae4t^l»vBl > integer (Aax_«tat.nest level) Chen 

cuss (ftt4teiacnt nesting too deep^'charTstat nest zevell ) ; 
end if; * " 

— LOOP TO READ STATEMENTS 
stat^loop : loop 

OBTAIN A NEW STATEMENT 

obtain^statenent (stat_nest_level» stat^line« £tat_lcng, 

" stat_type^ tMutt jtype, stat_nua, co=;p_loc) ; 

— DEBUG PRINT 

if print level >- S then 

put line {"from obtain statenent;*); 

37 
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put lin^ <** >• £ Stat llBe{l«,^at Xeng) i '<*); 
end If; ~ 



SET FIRST A)ID LA$T COUDMBS TO EXCIUOE FIRST WORD 
cO r- vo£d_bsr^k(l, stat^llne); 



nUPROWJCTlVE STATEMEHT TfBt$ * 



if fftarjtype In uiiprodaeclve_stAt.fittftnt9 then 

CGNPLAIN IF STA7£M£1IT TYf E NOT BEC0GUI2ED 
If stat^type - imki&Q«fn_llno then 

coss {statement not recognized); 
end if; ~ " 



FUNCTICaiM. STATSMEKT TYPES — 



eiBir «t«t^type in fuAetlon«l_5tat«ments then 

nroiCWE IP IT'S TOO IATE FOR A DECIARE OR DEFINE STATEMENT 

If 3tdt_type not nonexeeut£±_$tat«ments then 

derdecsjslcay false; 
end its 

IF STATEKEUT LIES OUTSIDE OF ANY SEC Oft 

if (current_block type /- seq_bl<scicer and 

eurrent_block3iype /• aubaeq_baockcr) and 

srat_type not^'in block openers and 

stat^type /- clQ«e_blocker and 

stat^type /- decio^_statement and 

statjtype define ^totemcnc then 
— CCMPIAIH 

eus8 (no_««qj>r subse^open); 
end if; * 

CGMPLAIH IP IJkST STATQfENT KOT A Bl^K CLOSER 

if next_type ■ ond_of^input and stat typ© /= close blocker then 

cnss (end with close blocker); "* 
end if; - - - 



BL0CKIN6 STATEMESITS 



if stat^type in block lA^_stat«ments then 

IP IT»$ A BtOCK OPESER,.. 

if «tat_type in bloek_openers then 

~ IF THIS IS FIRST BLOCK OPEKER... 

if current Jblock type - unknown line then 

— IP IT'S A •BCNDLE- 0PE!IER,.7 

it stet_type = bundle_bloeJter then 

PERMIT SVO LEVELS OF BLOCK BIESTINC 

block_l^vels_al lowed 2; 

— OTHERSnSE t-SEO* OR •SOBSEQ") . . , 
else 

ALLOW OIZLY OSZ LEVEL OP SLOCK MESTIK& 

block levels allowed i- 1; 
end if; " 
end if; 

SAVE BLOCK TYPE 

bloeJe_type_save stat_type; 

eurrentj»lock_type :* atat_type; 
SAVE BLOCK LOCATION 

block loc save :« comp loc; 
— - SAVE BLOCK KAKE 

block_natte_aave pBd(wird(2, stat_iinel , ni«x_nam©_iGngtn) ; 

COMPLAIN IF BLOCK UABIE IS tTOLL. , . 

if trim (block nattB_aave) • then 

CU4S (block not naned); 
end if; 

PILE BLOCK HAME 

file^naae (block_natte_save, stat^nun, 

coaip_jdata (cottp^loc-v4j # eamp^data ( compel octb) ) ; 

~ FILE BLOCK 

file block (bloek.namc save, blocJc_loc_save, block n\sr. save) ; 
P1LE~BL0CK NOKBER " " 

conp^data (comp loc^l) ;> block num aave; 
FILE BLOCK FIfSt UNE 

comp.data (conp^Ioc^2) stat_num; 

~— AlXOtf DECXARATZONS AMD DEFIHITiaV^ 
defdec£_ok4y :« true; 

end if; 
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MATERIAL PABTICOLAS TO SPECIFIC BLCXnUHG STATEMENTS 
caBQ blocklng^Btareaents* (s^c^type) Is 



P«9« 4 



BUNDLE 

comp^data (coop^loe) 

ctimp^dara (e^sip^Ioc-f 2) 
coop^dara (comp^ioo^3) 

eoi&p_dAta (eattp I6£<f5> 



pointer to block entry 
fir&t Acatem6&r m bundle 
last statemant In bundle 
ppintc; to start o£ nanus 
pointer to end ot name 



when bandlejblocker 

SET SCRIW KAM& FOR "BUNDLE** 

script ttane pad(wird(2, dtAt_line) , max name le&gtb); 
COMPLAXH IF •BONDLE* STAIQIEBJT KOI FIRST LINE IN SCRIPT 

if stat^atm 1 then 

cuss <bundle nust_coiac_first) ; 

end If; 

CCMPLAIH IF BUNDLE HESTED TOO DEEP 

if stat^neflt^level > 1 then 

cuss <bQndle_nested^too_deep) ; 
end if; " - - 



COMPLAIN IF ANY ADDITIONAL MATERIAL ON UNE 

eu&s_ext4ra<keous_ttacerial (Mord_bre&k<2, £tat_line), £tat_line); 



SEQUENCE 

ooop data (cdop^loO - 8eq_blocXer 
comp^data (coorp^loc^-l) pointer to block entxy 

coop^data <coBv^loe^2) * firct statciocnt in «cq 

«osip_data (caR«ri0C«-3) • last atatenent in seq 

cQBp^data (coii9~'loc+4) • pointer to start of name 
^Oftp^data (cop^^'loc^S) pointer to end of n^e 

eaap3dAta(C6fl4Brxoei-6) ^ initial atatua 



When seq^bloelcer 

CCMFLAIH IF SEQ NESTED TOO DEEP 

if Stat nest level > block^leve Ismail owed then 

cuss <saq_n»sted too_dccp, ohor(stat_ncsL_levelH ; 
end if; 

SET SEQOEBCE INITIAL STATUS 

if wird(3, atat_line) - •INACTIVE* then 
coffip_data (eomp loet^S) 

half integer (block atatua^type • pos (seQ_lnactive> ) ; 

else 

camp data(caiBp^loc+6) 

Ealf^lnteger (block_statu5_typc'po5 (scq^vcti ve) ) ; 

end if; 

CCMPLAXM IF ANY ADDITIONAL MATEKIAL ON LINE 

cuss^eactraneous^material <word_break(3r stat_line), stat_line); 

SMAPSKOt CURRCNT NUMBER OF KAM&S 

n^nanes^snap n^nancs; 



SUBSEQUENCE 

comp^data <comp^loo> 
comp*data (comp^loc^-l) 
comp'data (comp~loc^2) 
comp'data (comp^loc4-3) 
comp*data (ccmp^loc*4) 
comp^data (comp^loo+S) 



8ubseq_blockcr 

pointer to nanve 

first statement in subseq 

last statement in subscq 

pointer to start of name 

pointer to end of name 



when 5ubseq_block«x •> null; 

COMPLAIN IF SUBSBO NESTED TOO DEEP 

if stat_neat_level > bloek_level3_allowed tnen 

euas (aubaeq_Bested_too^deep, char(stat_nest_le7dl} ) ; 
and if; ~ 

COMPLAIN IF ANY AOOITIOMAL MATERIAL ON LINE 

cuss_extraneou3_material (word_break (2, atat_line>, atat_line> ; 

SNAPSHOT CURRENT NUMBER OF NAMES 

n_^naaes_sBap n_names; 



CLOSE 

~ cQ&p data (eflap_loe) * close_blocker 

comp data (eemp lodtl) - block pointer to current block 



when eloaejttlocker 

COMPLAIN IP ANY CONSTRUCT IS OPEN... 

if const loc s»vc > 0 then 

" " 39 
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Quss <constrnet_open__«c_close) ; 
end if; 

IF HO Bloat is C»£M-.» 

if falee]c_loc_»9v« = 0 then 

— - COMPIAIH 

cu£s <no_block open. At close) ; 
OtH£R*fISE,4. " 

fiAVe ?CZNt£R BACK 70 BLOCK 0?£N£R 

ceap dAtA(conp_Xoc^l) ;* block num save; 

FILE"HL0CK IAST LIM£ 

eoap data (bIdek:_loc_5ave'>>3) :- at at Aum; 
— cohpEain if opTioim. wsat doesn^t match 
if wird<3, «tat_line> /« and 

wird(3, stat_XiBd> tria(blocic_naffle_2av*> then 
cuss {cloae_naBe miAnstch, 

«fird(3, stat~line) A " wcr«u5 * & triaibloelc name save)); 
end it; ~ ~ ~ 

end if; 

~ COKPLAJN IF S£COtlD «OEU> ABSENT OR BIOT REC0GNT2ED 
if wird(2« fltat_iine) /= "BUNDLE- and 

wird(2, Btat_linc> /= -ACTIVITY- and 

wlrd(2, Stat line) /- -PROCEDUSE- and 

wird(2, atat""liBfc> /• -SSQ* and 

wird(2, stat'lina) /- "sraSEQ- and 

wird<2, ar«t]|^line) -SEoaENCE- and 

wird<2, atat lltte) /■ -SUBSEQUENCE- then 

cuss {close Tnedift^etc); 
end if; 

-i.- CGMPLAIH I? THERE IS EXTRANEOUS MATERIAL 

GU3S_extr«f;eou5_material <word_break <5, 5tac_line), stat^lina); 

— - SHOULD IT BE A 'CLOSE BUJiOLS*? 

if block_^type__aave • bttndle_blocker than 

COMPLAIS IF CLOSE TYPE DOES NOT CORRESPOND 

if wird<2, atat_line) /• -BUNDLE- and 
wird(2, Stat line) /• -ACTIVITY- and 
wird(2, stat~line) /- -PROCEDURE- then 
QMS s (dose jiLismat Chad, 

wird<2, Stat line) a - versus • * -BUNDLE-); 

end if; 

»— SHOULD IT BE A » CLOSE SEQUENCE* 7 

elsif bloek_type_aavc « seq^blocker then 

COMPLAIN IF CLOSE TYPE DOBS NOT CORRESPOND 

if wird<2, stat^line) /- -SEO* »nd 

wird<2, stat^line) /- -SEQUENCE- then 
cuss (close misfflatcned, 

wlrd(2,''stat line) i - /- - * -SEQUENCE-); 

end if; 

SAVE POINTER BACK TO BLOCK OPENER 

comp^data (cfiimp_loc4-l) 2= block^nu2i_save; 

RfiSfiT CORREHT NtWBER OF NAMES 

n^names n_nattes_snap; 

SHOULE IT BE A 'CLOSE SUBSEQUENCE*? 

elsif bloek^type__aaye - aubie<5_blocker then 

' COMPLAIN IF CLOSE TYPE DOES NOT CORRESPOND 

if wird{2, atat line) /- -SUBSEQ- and 

wird<2, 3tat_nne) /= -SUBSEQUENCE" then 
cuss (close mi$!Batchcd, 

wlrd(2,"atat line) « - /- a -SUBSEQUENCE-); 

end if; 

SAVE POINTER BACK TO BLOCK OPENER STATEMENT 

COiap_data (comp^loc^l) block_num_£awe; 

RESET CURRENT NUMBER OP NAMES 

n^naoes n_name2_6nap; 

«nd if; 

end ea^e; 



CONTROL STATEMENTS 



elsif stat^type in control_statetBent$ then 
IP ir*S A CONSTRUCT OPENER,.. 

if atat_type in const ruet_opcners then 
SAVE CONSTBCCT TYPE 

const type_save scat type; 

SAVE CONSTRUCT LINE NUMBER 

eonst_num_save stat_nujn; 
SAVE CONSTRUCT LOCATION 

conat loc save coBip_loc; 
end if; ~ 




IP 17*5 A CQtfSrmTCS OP&KCR OR IKmiFIER,.. 
it ^ac_type la coast ruec_opener« or 

BtAt_typo in construct BMtltier^ then 
— MMOVZ OPTIQiaL •THe»*"*rROM THE END 

If wird<-l, 8tat_Un«) • -THEN* thon 
el :« word br«ak(<-l, 0tat_llae); 

end if; " 
ftnd if; 



MATERIAL PARTICnZAR TO SPECIFIC CONTROL STATEMENTS 
case contifoi_*t»teBwnts» (ctat^type) ia 



WHEN or NHEH/COHTIHDE 
CQop^data (comp^loe) 
ccmp^dat* (cobrp'Ioo*-!) 
conp^data {ccacTj^^d) 
oomp^data (ccmp*loc<i-3) 



tthen_5t©t€ro«nc {or when cont stateffient) 
coast ruet /modifier lino"(0 il when cont) 
otherwise/and line (0 if whcn^contf 
loG of singular boolean component 



when wh«n^«tatament I when_cont_*tatc»cnt => 

SET COHSTRUCT/MODIFIER LINE 

eoBp_data <9Qap^loc+l> stat_nun; 

— * IF IT^S A WHEN/COMTIHUE STATEMENT... 

If wird(-ii 5tat line) - -aarriKUE* thth 

RESET COLOMirPOlMTeR 

cl word_brc4k(-l, «tat line) ; 

RQfCVE THEN- IF AMY 

if wird(-2, atat_lln<!) - -THEN* then 
ol 1- wo«rd_br€fcak(-2, stat_line)? 
ond if; 

RESET STATEMENT TTPE TO "WH EH /CONTINUE - 

atat_type :■ when^cont^statement; 

c^p_datA<co»p_loc) s="half integer (comp type type * po« (when cont statement)); 
RESET INDICATOR THAT A CONST'kUCT IS OPEN* " - - 

conct^loe^save 0; 

— OTKERtflfiE... 

else 

SET LOCATION FOR POSSIBLE M<a)IFIER LINE 

const jBOd_loc eoinp_loc * ts 
SET LOCATION FOR POSSIBLE -OTHERWISE- LINE 

const oth^loc :« ooiap_loc + 2; 
SET TOrtATIVE LOCATliW FOR "END- LIKE 

const end loe oomp loo 2; 
end if; " " 



INVOKE COMPONENT PARSER TO FILE CONDITION 

parse^componant (stat_line(c0..ol), ct, oomp_daca(co3ip_loc+3) , ce); 

CCMPLAIN IP COMPONENT NOT OF SINGUIAR BOOLEAN TYPC 

if OS > 1 or not (oc in boolean compa or et - unknown_cQnip) then 

cuaa (fitat_needs_boolean_sinale, stat line <cQ. . £i> ) ; 
end if; ~ 



WHENEVER 

coQp^data (comp_ioc) - whenever_5tat«aent — — 

cofflp3data(cofflp_loc^l) - construct/modifier line — 

ooiQp3data (comp_loet2) - end line 

coop^data (cQBip~loc^3) - loe of aiqqular boolean componeat 



when whenever^statement -> 

SET CONSTBDCT/MOOIFIER LINE 

camp_data<camp_loctl) :- stat_num; 

SET LOCATI^ FOR POSSIBLE MODIFIER LINE 

con«tjnod_loc ;- compel oc t i; 

— SET LOCATION FOR "END* LINE 
coast ^end^loc co2^_ioc + 2; 

INVOKE COMPONENT PARSER TO PILE CQNDITI^M 

parse_ca&ponent ( stat^ll ne (cO . . cl ) , ct , conp^da t a { compel oc+d ) , ca) j 

COMPLAIN IF COMPONENT NOT OF SINGULAR BOOLEAN TYPE 

if OS > 1 or not (ot in boolean^compe or ct - a^known_conip) then 

euaa (atAt_Aeed«_booloan sinale, stat_iine <cO . . cl ) ) ; 
end if; 



EVERY 

coiep^data (comp^loe) - every_st4ter.cnt 

comp^data {eomprioe^l} - conatmct/Rodifier iine 

coiap]]|data fcoBip_loe*2) - end iine 

comp^data (cfls&pT^oe^S) - loe of ainovlar numeric component 



when every^statement -> 

SET CONSTRUCT/KQDXFIER LINE 

comp_^data(camp_loc+l) stat^nua; 
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SET LOCariON FOR POSSIBLE MODIFIER LINE 

SET LOCAIIOH FOR •END" LIJTE 

eon5t_9nd_loe compel oc +2; 

INVOKE COMPOHEHT PARSER TO flLE C0KDITI<»1 

parfifi_eompon«iit <Btat^lin6 <£0. ,cl) , ct, comp^data <eomp_ioc+3> , cs) ; 

COMPLAIN IF CCKPOSEMT NOT OF SINGULAR NUMERIC TYPE 

if cs > 1 or not (ct in numeric^compa or cl - unl;nown_comp> then 

«uss (Stat ne6d3_nua£ric_s ingle, sta^ llr.e<cO, ,ci) ) ; 
end If; 



IP 

- — conpjdata (camp_loe> • if_statemant — 

" — cqs)p3^^^ ^^^^P.^^^**"^) * noxc else/end line — 

— eomp_data (coanp^loe^?) • loc of singular booleaA component — - 



wh«n if^statemenc 

Sfil LOCATION FOR MODIFIER LINE 

const_mod_^XOC ?" compel oc +1; 

SET LOCATION FOR LINE 

const_ena_loe :- map_loc +1; 

INVOKE COMPONENT PARSER TO FILE CONDITION 

parAe_eo»pon«nt (scat^llne{cO, ,£l> , ct, coinp_data(coiBp_ioe+25 , os>; 

CCMPLAIH IF COKPONENT NOT OF SINGULAR BOOLEAN TYPE 

if es > 1 or yiot (ct in boolean conp& or ct - unknovn comp} then 

cuss (atat_neftd5_bool«an single, stat 1 ine (cC . .ciy) ; 
«nd if; 



BEFORE — 

comp_data (cosQ9_loc) - oefore_fttAtemcsnt 
— coiiLp_dara(eottp_loc^l} - loc of singular boolean component — 



when before_atatemont null; 

' COMPLAIN IF NO "WHKJ/WHENEVERy EVERY* OPEN 

if const_cype_SAve /- when^statement and 

const^type_8ave /• wh©nev«r^statement and 
coRst*'type_aave /• cvcry^scatement then 
cuss 7k>efore_within_outsidG) ; 



OTHERWISE,. , 

COKPLAIN IF THERE 1$ ALREADY A -BEFORE- OR -WITHIN* 

if conp^datra (coaat mod^loc) /- const num_isave then 
cuss {before_wTtliin_a 1 ready) ; 
OR COMPLAIN IF "BEFORE- DOESN'T FOLLOW CO?JSTRUCT OPENER 

els if Stat num /- con*t_nura^savG t 1 then 
cuss (Before within^misplacea) ; 

end if? 
SET M<»IFIER LINE 

coop data (coBflt jBod_loc> atat_nua; 
■ INVOKE CCMPCNENT PARSER TO FILE CONDITION 

P»r5e_coopoiient <atat_Xino (cO. .cl) , ct, co!np_data(comp lo^+l) , c5) ; 
COMPLAIN IF COKPONENT NOT OP SINGULAR BOOUIAK TYPE 

If cs > 1 ox not (ct in boolean_coap£ or ct = unknown_comp> then 
cuss (Stat aee<l$ boolean single, star, line (cO. . cl) > ; 

end if; " * " 

end if; 



WITHIN — - 

— comp_data (conp^loe) ■ within statement 

— coapjdata (comp^loefl) • loc o£~aingular numeric cocponent 



when within_fltateaent ■> null; 

COMPLAIN IF NO "WHBN/WHENBVER/EVERY- OPEN 

if oonst.cype^save /- whcn_statement and 

eon*t_typo_save /- whencver^stateaent and 
con£t_type_save /- every^stateaent then 
(bef ore_within_out a i do > ; 

OTHERWISE.,. 

else 

CCMPLAIN IF THERE IS ALREADY A -BEFORE- OR "WITHlN- 

if compjdata (const modulo e) /• const nuBi^sawe then 

eoAS (beforo wit hin_al ready) ; ~ 
OR CGMPLAIK IP •fflTHIN" DOESN'T fOLLOW CONSTRUCT OPENER 
els if 8tat_nu& /• const _num_*ave r i raen 

cuss (before within r.isplaced); 
end if; 

SET MODIFIER UNE 

camp data (const mod loc; £tat nur.; 
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mvOKE COMPOMEUT PARSER TO PtLE C<»IDITION 

parse_eettpon8nt<«tat_llne(eO,.cl), cc, conp aacAfeoop loct-l), cs) ; 

CCMPLAIM IT CCHPOHBWT NOT OF SIMGDIAR NUMF.nrc TYPE " 

if es > 1 or not (et In numcric_comp3 or et - unknown ccsnp) men 

eusa (9tac.no«d8.nui(ieric_aingic, «at_line(cO. -clM ; 
end if; 

eftd if; 



OtMERWISZ 

c«inp_data {ooBBp^idC) » otherwise atateausnt 

— co^^dota (comp^iocf 1) - end line " 



when othezwiae_atete»cnt o null; 

CCMPIAXN IF NO WHES OPEM.., 

if eonst^type^save /- «hen_*tatGinent then 
CU99 (othervi8e_out.Aide) ; 

OTHWOaSE... 

el^e 

CCMPLAIU IF THERE IS NO "BeFOKE- OR -WITHIM- 

if cofflpjdata(eoaftt_8iod_loc) - confft_num_£:ave then 
cuaa <otherwl$ejaGanin9less) ; ~ 

ond if; *~ 
COMPIAIS IF THERE IS AWEADY AN "OTHERWISE- 

if oomp data(csonat__oth__ldc) > 0 then 
cuss (otherwise already); 

end iz; 
— SET •OTHEHSfXfiB* LIME 

GOBp data(Cdn«t_pth_loc) ;- stat num; 
RESET LOCJVTIM FOR -EHD- LINE 

con«t_cnd_loc 2- camp lot -r X; 
end if; 

COMPIAIM IF THERE 13 EXTRANEOUS MATERIAL LINE 

cuss_eartraneoufl_tt*terial {word^brealc (1, stat^line), stat_line); 



ELSEIF 

— eoB^_d«te (CQop^loo) - elA«l£_$tatement 

coapjdata <cecap~loc+l) end_liafc 
comp^data<eottp__ioc*3> loc 6t singular boolean costponent 



when elseif^statement ■> null; 

COMPIAIH IF HO -IF' OPEN 

if const type_$«ve /■ if^statement then 
cufls" (eiae_Ottt«id«) ;" 

— - OTHERWISE 
else * 

— • SET •ELSEIF* LINE 

cofflp data <coa«t j&6d_loo) := stat nua; 
RESE? LOCATION FOR -END* LINE " 

const end loc camp_loc 1; 
COHPlXlK If there is already an "ELSE" 

If const^else^ntn > 0 th^n 

cuss" (else already, ch^t (const else num)); 

end if; " - - 

SET FXAC TO INDICATE AN "ELSE- 

coxutjelsc_num s* atat_nua; 
INVOKE COMPONENT PARSER TO FILE CONDITION 

parAe_eonponcnt (stat line (cO. ,£l) , ct, comp dataicosp loc^2), C9); 
— COMPLAIN IF CCNPONENf NOT OF SINGULA? BOOLEAN TYPE 

if c£ > 1 or not (ct in 5oolean_^comp:s or ct - unknown coap) then 
euAA (stat needs boolean_eln^le, stat Iine(c0..cir); 

end If; - 
end if; 



— ELSE 

— conp_dat:a(eomp_loc) ■ else^statement — - 

— coiRp^data<comp_loc+l) ■ end_lina 



when else^statestent null; 

COMPLAIN IF NO 'IP* OPEN 

if conat_type_d4Ve /- lf_statement then 
cuss (elself_out$ide> ; 

OTHERWISE 

else 

— SET •ELSE- LIKE 

conip_data (coast_&od_:oc} i' stat nu2i; 

RESET LOCATION FOR -END- I-INE 

const end_loc eottp_loc - \j 
COMPIAIN IF THERE IS ALREADY AN *'ELSB** 

if const^else^nuB > 0 then 

cuss* (else already, char (tonst^cis© r. JLTO ) ; 

end if; 

SET FLAG TO INDICATE AN -ELSE- 

const «lse_num t---stat_nur;; 

/3 
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CGMFLAIN IF THERE IS EXTRANEOUS KAXERIAL ON LINE 

cus«.cxcranoou5_Batcrial <wor<i_br«ak<l, 5t»t_linc), 5tac_Unc); 



EHD . 

conp_data (coap_loc) - end_statom8nt 

COmp»_^Ca {Comp_loC+l) • ppintcr tP corresponding opener Itftfc 

when end^at^t^ftenr -> 

— IP KO COMSTRnCT IS OPEN... 
if const loc save « 0 then 

— compIwiTthax ho construct open... 

eusa (no_conatruct_open) ; 
OTHERWISE..- 

— SAVE POINTER BACK TO COHSTRUCT OPENER 
eomp_data (eanp_lee>l) :* confit_nu& save; 

COHPLAIN IF TYPE MISMATCH 

If wird{2« stat^line) /= *" and 

wird(2, Stat line) y= keyword (constat ypc_5avQ) tbftn 
cuss <cndjni«»tched, wird<2, 5t4t_lirie) i " /- • * 
keyword (eon&c typ6_±ave> ) ; 
end If; " 

SET LOCATira OF END LINE 

comp data (const jeskd^loG) :^ scat_nus; 
ZERO SAVED C(»ISTRUCT LOCATION TO INDICATE CLOSURE 
const loc save i*- Ot 
end if; ~ " 

COMPLAIN IF THERE IS EXTRANEOUS MATERIAL 

cu&i extrAtteoufi ttaterial (word break (2, ^tat line), stat line); 



WAIT 

conp data (conip.loc) » wait_5tatcm«nt 

coiap~dnea (eosip_loef 1.) - loc of singular nuneric componenc 



when wait^statement 

INVOKE COKPONSNT PARSER TO FILE CONDITION 

parse_fiaaponent latat^llne (eO , . cl) , et , coii^_<iat a i coap_ioc+l ) , cs) j 

COMPLAIN IF COMPONENT NOT OF SINGULAR NUMERIC TYPE 

If CS > 1 or not (ct in nisaeric^comps or ct = unknown^conp) then 

cuss (stat_needs^numeric^slnQle« 5cat_lin(} (cO . .cl ) > ; 
end if; ~ ^ 



CALL 

— comp data (comp^loc) = start_5tatcmcnt 

eeop'~data (comp^Ioc^l) - pointer zo subscq block 



when call statesent 



FILE INFO ABOUT RtFfiREKCED $UB££Q 
n_5s_ops := n_is_ops i- I; 
If n~»s_op* > rw50p thefi 

(toojnany_»A_ops) ; 

el£e 

^jaaBe(n_88jop8) paC(wir<lC2, stat_line}, ma!i_nainc_l«ngch) ; 
ss2op_stat(n""flajops) stat^r.nn; 
88 op l>iocl£_Toc (n s£ ops) compel oc + 1; 
end if; " 



end case; 



ACTION STATEMENTS 



els if stat^type in action_5tatc»8enta then 

MATERIAL PARTICULAR TO SPECIFIC ACTION STATEMENTS 

cade action statements* <8tat_type) is 



SET 

cccnp data {coiap_loc) * sec^scatement 

coop data{co(np_loctl> - componenc to be written into 

comp^'data (c«BP l9C-»-2) * macerial to be written 



wh«n SET STATEMENT -> 



LOCATE OR OR THE WORD -TO*... 

loc*te (" TO Stat llnelcO. .cl) , copO, copl, cu-side_parens) ; 
If copo 0 then 

locate C :- Stat line (cC. .cl) , copC, copl, Qwt5idc_p»rena> ; 
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end if; 

if copO 0 thea 

locat« <* » *, Stat lln9<cO..Cl), COpO, copl, oucside^arens) ; 
And i£; 

CGHPXAIN ir MO DELIMITER 
if copO • 0 then 

cuas (set jdelimiter joiasino, at at^l ine (cO . . cl n ; 

OTHEI)39IS£,., 

INVOKE COKPONBliT PAft5EE( TO FIt£ C0KPOkI£»T 

pftr«e_cofflponsnt<se.9t_llne(eo, ,e(»po-i) , 6t_l«£t, cp letc, cs left, write); 
... RECORD THE VARIABLE TO BE LOADED 

comp data<con|> loc^l) := ^^lefc; 
COMPSMN IP CCfiPOMEWT IS NOT OP A TYPE THAT MAY 8E SE? 

ctt«5_i f_not_*«tablc (cp_l e£ t , *ta t_ll ne (6C , , e6pO-l ) > ; 
COMPLAIN IF HO LOAD DATA 

if eopl >« el thftn 

cuss (set data missing) ; 
-— OTHERIflSE-.- " 
else 

IHVOKE CQMPOUEST PARSER TO FILE LOAD MATERIAL 

parse conponent (stat line (copl *1. .cl) , cc right, cp.riaht, cs_right, rca^)/ 
— REC0&6 THE MATEiaAL TO BE LOADED 
camp data (canip_loc+2) ;= cp riaht; 

CCMP^AIS IP MATERIAL TYPE DISAGREES WITH VARIABLE... 

If ct_lcft /« unknpwn comp and ct_right /« unknown cowp then 

ir ct_left in boolean_ecmps and ct_right Adt in bddle4n_comp« tftea 

cuss (8et_data._not b^lean, &tat_liAe (copl^l. «cl) ) ; 
elsif ct_le£t in nunerlc^oomps and ct right not in numeric^comps then 

cuss" (««t_data_not^nuraeri c, «tat_ri ne (copl-*-! . . cl) ^ ; 
elsif ct_icft~in charBCtcr_coiRp5 nnd ct_r4ght not in chwf»cter_eoB^a th^n 
(aet_data_rL0t_chAra£t6r^ scat_line (edpl+1, ,el) ) ; 

end if; 
end if; 

COMPLAIN IP MATERIAL IS NOT EQUAL IN SIZE TO VAR2AdLE, OR SINGULAR... 

if cs^right /» cs_left and cs right /-I then 

cuss (set sizes incompatlBle) ; 
end if; 
end if; 
end if; 



START / STOP / RESUME 

cciap_data (c«]tp_loc) » start_statomcnt or 

Stop_scat«ncnc. gj: 

rftAuaft_stAt«ifcAt 

--^ ettqp_datA(eQSAp_lde4>l> pointer to blocjc 



when start^statement..resame_statement -> 

... FILE INFO ABCKTE REFERENCED SEQ 
n aa^ops n^ss^ops + 1; 
iT n^ssjops > nsaop thea 
cuss (toojnany^ssjops); 

else 

ss^opjname (n^ss^ope) pad(wird{2, scac_linc) , raax_nainc_lcngth) ; 
ss^op^stat (n"'as'"ops) 8tat_naa; 
as op^loclt_Toc7B_sa_ops) s-~comp_ioc ■»■ 1; 
end if! 



HESSA^ 

comp_data (etinp_loe) « aesaage^atateasent 

ceBp_data (co8ip_loctl} • pointer to char string cocpcnent 



when meaaage^atatemant -> 

PARSE AND PILE COMPONEMT 

parse component (stat_l ine (cO. .cl) , ct, cQinp_cjat.9 (cocp^loci-l ) , cs, READ) ^ 
COMPlJCiN IP CCHPONENT NOT CHARACTER STRING 

if ct not in charactcr_eoaip» then 

cuss (mess.data not charActer, 5tAt_iine (cQ. ,cl) ) ; 

end If; 



OTHER ACTION STATQfEHT TYPES DEPIKED BY USER 



when others » 



PARSE USER-DEFINED ACTION STATEMENT TYPES 

parse^user^statenent (stat^Iire (cO. .cl) , »tac_Lypfi, eoaap_loc); 



end case; 



NON-EXECUTABLE STATEMENTS 

el$if $tat_type in nenexecute^atatements then 

CCKPLAIN IF IT'S TOO LATE FOR A DECLARE OS DEPIKE 
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If dfifd£es_olcay - ^al9c then 

cuss (roo lAte for d&fdee); 
«nd if; ~ 

— MTHEaiiO* PAATICULAR TO SPECIFIC SON-EXECUTABLE STATEMENTS 
case RoneKecute^sratei&anta< {stat^cype) is 



DECIARE 

conp_da%a (cgsnp^loc) 



= declare staremsnt 



cmpjlata (comp^l^^l) 
comp_data (coap^ioc^?) 

~data{CQDp loc^3} 
CQiqp2<iata (compel 0(^4) 



juac_lnt_var 

number of plecftfi (2l2e) 
pointer zc &z&rz ot name 
pointer co end ot name 
loc of variable 



when declare^stateaent 

— - ALLOCATE SPACE (CHANGE LATER IF TYPE NOT BOOLEAN) 
allocat;e^coinponeat (bool^int^yar, loc) ; 

FILE DECLMIATXON KAME (ALHAYS $£COKD WOftD) 

ttXe_tta*e <wird(2t rtat_linc), stat.nurc, 
oompjdattt <l0C+2) , CQ«p_data (lo^i-^) ) ; 

— LOOK FOR THE TYPE KEYWORD **B00L£A1}'* 

locate (* BOOLEAN*^ srat_line(c0..ol)« copo, copl); 
if copO > 0 then 

SAVE I^TION OF INTERNAL VARIABLE 

ecaip_<lat» (10C4-4} n_bool_int_v»r ••■I; 

else 

LOOK FOR THE TYPE KEYWORD "NUMERIC** 

locate (■ NUMERIC", stat_line (eC. ,cl) / copO, copl); 
if copO > 0 then 

SAVE LOCATION OF INTERNAL VARIABLE 

cofflp data<loc-«'4) n_num int var + 1; 
OVERWRITE INTERNAL VARIASEe TYPE 

comp^data (loc) 

Ha 1 f integer ( cowp typc_cypc • pes < nuin_i nt_v 9 r ) ) ; 

else 

LOOK FOR THE TYPE KEYWORD "CHARACTEK** 

locate (• CHARACTER-, 5tat_linc (cO, -cU , copO, copl); 
if copO > 0 thcfl 

SAVE LOCATION OF INTERNAL VARIABLE 

cfiop^data (10C4-4) n_ehar_lnt var ♦ l; 

— OVERWRITE INTERNAL VARIABLE TYPE 
eomp datadoc) 

Salf^integer (conp type_type 'pos {cnar int_var)); 

IF NO KEYWORD FOUND, COMPLAIN... 

else 

cuss (declare_tyi>e_aissing} ; 
end if; 
eiuS If; 
end if; 

LOCATE PARENTHESES, IF ANY 

parO location(" fltat_line (cO, ,cl) ) ; 

pari ;^ location <■)•, fltat_llne (c6, ,cl) > ; 

— IF THERE ARE PARENTHESES, OBTAIN SIZE OF VARIABLE 
if pari > parO then 

TRY TO PARSE IT 

parse component {stat_line (parC. .pari) < cc , cp/ cs) ; 

CONFLAIN IF NOT AN INTEGER LITERAL 

if ct /- nim_ntgr_lit then 

cuss (declare2size_no_9ood, stat^line <parO. .pari) ) ; 
num 1.0; ~ ~ 

else 

EVALUATE LITERAL AND SAVE 

eval^num^literal <cp, num); 

end if; ^ " 
SAVE SIZE 

coop data (Xoc-fl) ;* half_integer (num) ; 
CCKPLAIN IF SIZE MISPLACED 

if parO < eopo men 

cuss (declare aixe misplaced) ; 

end if; " 
OTHERMISE ASSUME SIZE IS ONE 
else 

comp datadoct-l) 1; 
end if; " 

DEPENDING ON WHICH TYPE,.. 

ca5C coa©_typc_typC'val (integer (comp_data (locj ) ) is 

BOOLEAN., , 

When bool int_var -> 

INCREMENT BOOLEAN INTERNAL VARIABLE COUNTER 

B bool_lnt_var n_Dool_int_var ▼ eoi^p_data (loc-rl) ; 

COMPLAIN IF LIMIT EXCEEDED 

if n bool_int_yar >- max toool_lnt_vars then 

cuss ftoojnany^boolJTnt vara) 7 
end if; 

NUMERIC • • • 

when mm Int var --^ 

INCR^IENf NUMERIC INTERNAL VARIABLE COUNTER 

n num int var n num int var comp datadoc^l); 

— complKin Tf i*imit acceSDED" 

If n num int var >~ ir.ax num ir.t vars then 
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euAft (too many nua int va£:») ; 
end if; " *" ~ 

CHXRXCtfiR... 

«hen ^ar int var -> 

IKCMSEHT^CHAKACTER IMTEaHAL VARIABLE COUNTER 

n_chAr_l«t_var n cnar int var + comp dacadoc+l); 
— - CGKPLAIN IP tJMIT BXCEEDED ~ ~ 
if n^char int_VAr >• ma«_char int vard then 

ooss (too many char int var«t7 
QBd ir; - - - - 

OTHERS 

When otltors «> null; 
end caae; 



BEPINC 

... COBp_d«ta (cofflp^loc) - DEFINE_$TATEHENT 

— camp_data (co»p_loc) — DEFIKITIOW — 

— comp_dara (c«(ftp_Ioc4-l) ^ loc ot (lAtined coniponent — 
comp_datA (eoBv^locH-a) » pointer to atert of name — 
camp_^darA (C08(p^Ioc«-3) — pointer to en<i of name — 

when DBFIIIB_$TAT£MEBIT -> 

ALLOCATE SPACE 

allo£ato_608tponent(D£FlNiri<»l« loc); 

FILE DEFIHITIOS tIAME (ALBCAYS SECOKD WORD) 

file_naae (wlrd(2» ctat^llne), fltat^num, 
coB^_data (lo6+2} , cSnp^data (loe+3) j ? 

LOCAIE THE WORD "AS",.. 

locate (" AS atar_llnc (cO. .cl) « copO, copl, outr:idc_parens) ; 

CCMPLAIK IF no •AS" 

if copO - 0 then 

cusB (no_a$_i n_de f ini t ion, st at_l i ae ( eO . , cl) ) ; 

OTHERWISE... 

el«e 

INVOKE COMPC»i£HT PARSER TO FILE DeflNED CCMFONESn 

parse^conpoBfiar (3tat_line<copl+l. .cl) / ct, 
coi&p_data(loctl), a); 

end if; 
end Cj&se; 
end if; 



CGfifPILE-TIME STATEMENTS 
else 

case stat_type is 



^ DIRECT — NO DATA STORED - — 

irhen direetjst a tenant 

SET PRINT LEVEL... 

if wird(2, 4tat_line) ~ "PRINT level" then 

CONVERT THIRD WORD TO A NUMERIC 

make_Buaeric (Wird(3, stat line), num, okj ; 

— IF OKAY USE IT TO SET PRINT LEVEL 
if ok • trvv then 

print_l«vel s«> half integer (num) ; 

— OTHERWISE COMPIAIK 
else 

cuss (print_i«vBl not numeric); 
end if; " 

— SET SCRIPT NAME... 

elsif wird(2, stat_llfte) - *'SCRIPT^HAME- then 

script^name pad(wird (3, *tac_iine), max_nA!fte_i<sAgLh) ; 

SET OPTIMIZATION FLAG... 

elsir wlrd(2, *tat_lin«) - "OPTIMIZE- then 
optimiie_flag true; 

RESET OPTIMIZATION FLAG..* 

elalf wlrd(2, stat^line) - "N0_0PTIMI2E" then 
optiaize.flag T" false; 

CHECK DATA BASE FOR ERRORS (IF APPLICABLE)... 

Ol»if wird(2, Stat line) - -CHECK data BASE- then 
CHECK^DATA^BASE; 

UNRECOGNIEED... 

els* 
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end If; ~ 



OTHERS 

when orherft •> null; 
and c»«c; 
end if; 

— LOGIC TO DETECT END OT SCRIPt... 
IP THIS IS TKt IA$T LIN£ IN BOHDLE, OR IN SCRIPT... 

If n.stats > 0 and <naxt type • end of input dr <st« type - cldsd blockor and 
block^type_aAv« - bnndle_blodlec7) >''th©n 

MRKE SCRS ALL REF^ENC&D S£QS/SnBSEOS AR£ PRESENT 
fdr i in l..n ss dps loop 
Bb 0; 

fdr j in l..n^blde)c3 

if trim (ss dp_aaffld<i}) ■ block naseO) ^.hon 
nb 'J; 

<^P_data(ss op block loo(l)) j; 
end if; - - - 

and loop; 
— ' CaiPIAIN IF NOT POOSD 
if nb - 0 then 

cuss (seq_$ubs9a not fouad, char<«« op stat{i)}); 

COHPIAIN IF IT SHOW BE"A SUBSEQOZNCt ~ " 

elsif block type(nb> 8ub8eqj>locker and 

5tatement_typ(««_op_stat(i)) - call statement then 
Ouss (op require&_«ubsaq« char(8fi op fit9t(i))}; 

COMPLAIN IF tt SHOOLD BE A SBOOEKCE " " 

elsif bloek_type(nb> /- aeq^blooker and 

(8tatement^typ(8B_op_atdt (i) ) = start_8tAtii£ment or 
st^tenient^typ(s8_op_stac (i>) = resuse_£t&teaent or 
St « cjoent^typ ( as_op_fit «t ( i ) ) - 8top_3t at ement ) t hen 
cuss (op^rsquiros seq, obor(s5 op stat(in); 
end ir; ~ " 

end loop; 

— SET DEFAOLr SCRIPT NAME 

If tri»(scxipt^naafi) • then 

script name pad ("SCRIPT* « max name lendth): 
end If; " ^ - 

PRINT FILE SUNMARy 

if prlnt^level >» 0 than 

print_timeXlner_u5age^summazy (trin («oript^name) > ; 
end if; *" 

PERHAPS PRINT DATA PILES 

if priBt_level >• l then 

print ti&eiiner data files (trim (script nazee)); 
end if; " ' " 

IF NO CnSSES WRITE OOtf OT FILE 

if n^cQss - 0 thon 

write_dat a_f t le ( "TL^" 4 trim ( scr ipt_naitie ) fi » . DATA* ) ; 
else * 

n cuaa_tdtAa :« n_cu3s; 
end it; 

RESET COONTERS FOR NEW "BUNDLE* IF ANY.,, 

n_name* :• 0; 
n^bldckft :« 0; 
n2[stata 0; 
n~oofflpa 1; 
n_cu«s 0; 
n as_op* 0; 
n~booX lht_var 0; 
n_nu»J"at_var 0; 
n^chax_lnt_var i- 0; 
n^nuBerie_Tlt* s" 0; 
n2character_lit5 i* 0; 
trap_oait_n_n«6c» 0; 
trapjBax^atatement^length 0; 
trap"maxj&Xoek^nest level 0; 
trap_max.stat^nest^Tevel 0; 
trap max^CQiDp^nest^levei 0; 
max 5ool_buff^usagfe 0; 
i&ax~num_buff a»ag« 0; 
max3char^buf?_usa4e 0; 

end if; 



LOGIC TO CHANGE LEVELS X7P OR DOWN. . . 

CALL POBINKARDS) IF THIS LINE IS OPENER OR MODIFIER 

if (atat_type in block_opanors or 

atat_type in eonstruct^openers or 
Btat^type In donitruct'modifiers) ana 



H t d 
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next^type a6t la con^trvecjsoclificTs and 
n«xtjcype cloae blocker aad 
aext^type /» ena_st9C«aen« th«n 
- — DEBUG PRIMT 

If prlnt_l«v«l 8 thsn 

put ("DOUH: ftt«t_ne5t_icvels 

put (char (8tat^nest_level) ) ; 

put C* statjtype: •); 

put (fitat typft); 

put (' " noxc_type: 

put (nextjcype); 

new_Xlnc; 
end It; 
— — RECURSIVE mVOCATIOH 

parse Btateateat (r&tttmjeode) ; 

IF RETURNING TO BLOCK LE7EL# BESET CURRENT RLOCK TYPE 

If block type save la block opeaera thea 

current block typo s- block type save; 
end if? " " 
end tf; 

EXIT (OVmCDS) IP VeXT UVE 1$ PZNIdHBR Oft MODIFIER... 

if (neactjtype in fioa«truct_t(odtfter« or 
aext_type • elo»e_block«r or 
nextjeype • end «tatetacnc) and 
8tat_type not la block_openers and 
stat_type aot la eoaatruet_q^«rA iXid 
stat^type aot la coastruet modi f then 

DEBOS PRimr 

if print^level >= d then 

put 7*0P« stat^aast^lavel: •) ; 

put ( char <«tat_n«It^l«v«l ) ) ; 

put (• ^at.typet 

put (fit at type) ; 

put (" * neaet^type: *); 

put (BQJd:_type); " 

new^llaey 
«nd if;" 

EXIT UWUSSS ALREADY AT TOP LEVEL 

if $CAt_ncst_l«v9l > 1 then 
exit; 

else 

ettS« (too nany finishers) ; 
end if; 
end if; 

EXIT IP THIS OR LOWER LEVEL DETECTED END-OF-riLE. . , 

ir aeactjtype • end_of_input then 

retum.codft end_inpot; 
end if; 

If return code - end_lnput then 

Qxit;^ 
end if; 

end loop ^et^Xoop; 

— DECBEMEHT NESTING LEVEL 

stat_nest_level atat_aeat_level • 1; 

sad parse_8tatemeac; 



OBTAIN STATEMENT: PROCEDURE THAT DOES THE FOLLOWING: 

* HEADS A HEW STATEMENT FROM THE INPUT FILE 

* IF IT IS AN •EXECUTABLE* STATEMENT, 

INCREKEHTS n dt«t4# RESERVES SPACE IN 

COJWijdata ARRAY* SETS COMPWEN? TYPE JH 

convjdata ARRAY, AMD SETS comp^loc TO 

POWT TO THE RESERVED AREA IN eoMp_data 

* PRINTS THE STATEMENT VITH INDENTATION 

DETERMINED BY THE IHPtTT PARAMETER level 
* RETURNS TO THE CALLER THE FOLLOWING INFO: 

• 5TRIN0 CONtAXKING ENTIRE STATEMENT 

• COLOWI LEWCTH OP THE STRING 

* TYPE OF THE STATEMENT 

• TYPE OF THE NEXT TATEMENT 

* SEQUENTIAL STATEMENT NUMBER 

« RESERVED LOCATION IN COnp data ARRAY *— - 



procedure obtain «t«tettent 



(level : in natural; 

atat_llae : out atat_atrlng_type; 

atat_leBg ; out column_type; 

Stat type : out ccinp_typ6_type; 

aaxt'type : out conpltypeltype; 

stat^nus : out stat^pointer.vype; 

CQfflp][loc : out comp_pOlnccr_typc) 



is 



LOCAL VERSIONS OF OUT PARAMETERS 

St at 1 in : statist ring^type; 

Stat 1 en : coluon^type t" 0; 

statype : comp^type^type; 

nextype ; comp_type^type; 

statnun ; stAt_pointer_typc 0; 

comploc ; cocap_polnter_type 0; 

FIRST AHD LAST COLUMNS OF RAW INPUT LINE 

eolcrst : coliBaA_type; 

col la St : eomma_type; 



4^9 
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F<» COMPUTIKC iNDEHtAnOH 

lndent_Aave * natural 0: 

?0H KBEPIKG TRACK OF OaOTATICN lARKS 

fiqudc : boolean false; 
dquot : bdolcan false; 



IF THIS IS THE FIRST 
if n raw llnea - o then 

SlANK LIME 

llne_raw s- <l«.max llne_lcngth -> • 
SET TYPE TO IKDICAIE START OF I»?UT 

lliwi_typ» s= ctart^of^inpuc; 
end if; " *" 

SET LINE TYPE FOR 0I7TPCT 
stacype ltne_typo; 

BIANK STATEMENT 

«tatlln 2= (l4.MRX_3tAt_ieneffH *>••>; 

LOOP TO PXltD THE REST OF THE $TATEM£1IT 
ilne_loop: loop 

IF TT*S A PUilCTIOJaL STATEHEST. . . 

if iific_type in fonctional^st^teoents th^n 

— IHCREUENT STATEMENT COOITtER <CDSS IF NO ROOM) 
if n^stats < mAx_$tats then 

n^stats n arats 1; 

statnum :^ n'stats; 
else " 

cuss (too_many stats); 
end iti 

... ALLOCATE SPACE FOR STATEMESn: 

allocate_coi»ponent (liae_type, cooploe) ; 

— SET POIUTER TO COMFONEHT DATA 
stat_loc(n_*tats) compXoe; 

PRIHT Lm WJMBER 

put (cfesr<n_$tats>>; 

SET IHDEHT ACCORDINC TO NESTING LEVEL 

indent^aave indent_r«»et + lndent_aelta « (level - 1); 
if Ilne^type in construct jnedlfiers then 

indent _save indent "save + indent delta / 2; 
end if; 

set_col {positive_count (ind^nt.save) ) ; 

IF IT'S A STATEMEUT COMTtNOATIOH* . , 

els if line type - unknQwn.llne then 

INDENT to FIRST WORD BREAK 

set_col (positlve^count <indftnt_5ave + wora^breax (1, ttimfct^tilin) )+l) ) ; 

OTHERWISE,,. 

else 

NO niDENXATIOM 

set col (positive count (indent re»«t)); 
end if;~ 

PRINT LINE 

put (trlmdine^raw)); 
aew_line; 

SET FIRST AND LAST COIOMN OP RAW LINE 

colfrst tria (11 nA_taw) * first; 
eollast := trlaaine_rsw) Uast; 

RESET LAST COLUMN IF THERE'S A COMMENT 

if location line_raw> > 0 then 

collar :« locationC— line raw) - 1; 
end If; " 

ADD LINE TO STATEMENT, IP POSSIBLE*., 

if ^atlen col last - eolfrst < MAX_stat_lengTH then 

— COPY CHARACTER BY CHARACTER.,, 
for 1 in colfrst..collast loop 
SINGLE OR DOaSLE OaOTE? 

if ilne_r«w(i) • and squor - faJsc then 

dquot not dquot; 
elsif line raw(l) ■ *<» and dquot - fAlse then 

squot not squot; 
end if; 

if line raw(l> - then 

dquot not dquot; 
— elsif line_r«w<l) - then 

squot not squot; 
" end if; 

IP WITHIN QUOTES... 

if squot true or dquot - true then 

COPY AS IS 

station 1- Btatlen -f l; 
*tatlin(fltatlen) ;- line_r»w(i)7 

OTHERWISE... 

else 

ELIMINATE KOLTIPLE BLANKS, REPLACE TAIJ 

— CARRIAGE RETURN WITH BLANKS, AND COSJVERT TO 0PP2R-CASE 
if line rsw(i..i+l) /» • • then 
Stat 1 en station 1; 

if line_;rAw(i} ■ accii.hc or line_raw(ij = ascii.cr t^er. 
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sratllncatatlen) :^ * *; 

statlin<«t«tlen) upeasc(lift&_raw (i)) ; 
end If; 
end If; 
end if; 
^■tf^ ^f loop/ 

INSERT A BLANK 

statlwi stati9n 4 l; 
stAtiiEk<8rAtien) s- * *; 

OTHERWISE COMPZAIM... 

cusa {statentent too long) ; 
«nd if; " " 

READ NEW LINE AND INDICATE IF END*CF-PIL£ 
line^xaw <l..max_liBe^laB9tb ^ • '>; 
li&ejtype unknown_llneT 
begin 

n_rav lines n^zav lines 1; 
get^llne ( 1 i ne^ra«« ircs^Ieng) ; 
exception ^ 
when end_error -> 

line_type en<i_of_input; 
end; ~ *" 

— ASCERTAIN TYFE GT NZtf LINE 

if llnejtype /■ end of_input then 
It pSfint_ieveX >• 10 then 

put_line (■obtAln_fttAtetti6nt exiling ictati&ment typ, with:**); 
pot line r >* txpcasedine raw) & *<*); 
end if;~ 

line typft statcmcnt_typ(Upc»«c<X4ftt_raw) >,- 
Tt print level >- 10 then 

put T'obtain^stateoeBt receives frozi statement^typ: 

put (line.type); 

new line; 
end if;" 

end if; 

EXIT IF NEH LINE BEGINS ANOTHER STATEMENT 

exit line_loop when line type /- unknown_line or 
statype - blanJc_line"or statype - eomaent^line; 

eftd loop llne^loop; 

CGH^IAIH tt QOOXATXQN HAIUCS UNBALANCfiD 
if squot ^ true or dquot ^ troe then 

cuss <quote8 unbalanced); 
end if; 

SET NEXT LIKE TYPE FOR OOTPOT 

nextype :- linejtype; 

DBBUC PRIST 

if print_level >" 7 then 

put (•obt4in_*tate»ent:*>7 
new_itne; 

put <• <t4t_llne: >• c statlin (I.. station) * *•< 
new.llne; " 

put (** »tat lengs ** « char (stat Ion) ) ; 
put (• 4taC_typo: *); 
put {statype); 
put (* next.types *•); 
put (nextype); 
put <** stat^nuat *); 
put (char (statnun) ) ; 
put (** coap loc: **); 
put (ehartoonpToc)) ; 
new_iine; 
end if; 

TRAP NAXXMOM STATEMENT X£KGTH 

ir *t*tlen > trapjttax *tatette»t_leftgth then 

trap Bax_3tatefflent length stArien; 
end if; " " 

SET OOTPOTS 

Stat line :• statlia; 

stat'leng station; 

stat^typo J- statype; 

next*typo j- nextype; 

stat][num statnum; 

comp'loc :* comploc; 

ond obtain.statcment; 



end M_p«ir$er; 



